User blog:Rgetar/Ordinal Explorer v6.2
Today I created program working with Bn = + 1: :B1 = Ω = L :B2 = L = R :B3 = R = S :B4 = S = B5 :... It is different from v6.0 and v6.1, working with L and R respectively, it generates different lists, so I suspect that v6.0 and v6.1 may contain errors. v6.2 does not work with all Bn simultaneously (I am going to do it in next version), it works at the same time with only one Bn, where n is contained in variable blevel. =Source code= Delphi 7 source code. unit OrdEx; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StrUtils, Math, ScktComp; type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Label2: TLabel; Label3: TLabel; ServerSocket1: TServerSocket; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Edit1: TEdit; Edit2: TEdit; procedure Button1Click(Sender: TObject); procedure Serversocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure Form1Create(Sender: TObject); procedure Form1Destroy(Sender: TObject); end; lis=array of record s{,i}: string; c,l,n: integer; end; rar=array0..19 of string; var Form1: TForm1; st,st1,bo,cout,qhost,fa,col,ercode: string; s: lis; f: textfile; b,bn,g,er: boolean; cn,cl,sl,br,blevel: integer; duq,uq,bro,brc: rar; implementation {$R *.dfm} // get position of last symbol p of string st (if l=true then first) function getls(st,p:string; l:boolean=false):integer; var e,np: integer; begin if length(st)=0 then result:=ifthen(l,1,0) else begin if l then e:=0 else e:=length(st)+1; np:=0; repeat if l then inc(e) else dec(e); if ste='then dec(np); if st[e=']' then inc(np); until (not l and (e=1)) or (l and (e=length(st))) or ((ste=p) and (np=0)); if not l and (e=1) and (st1<>p) then e:=0 else if l and (e=length(st)) and (ste<>p) then e:=length(st)+1; result:=e; end; end; // create boosterbase string function bb(booster,base:string):string; begin result:=''+booster+''+base; end; // get base of string st function base(st:string):string; begin result:=copy(st,getls(st,']',true)+1,length(st)); end; // get booster of string st function booster(st:string):string; begin result:=copy(st,2,getls(st,']',true)-2); end; // get successor of ordinal st function suc(st:string):string; begin result:='[]'+st; end; // get predecessor of successor ordinal st = X + 1 function pred(st:string):string; begin result:=copy(st,3,length(st)); end; // finite ordinal string st to number function fostn(st:string):integer; begin if st='' then result:=0 else result:=(length(st)+1) div 2; end; // finite ordinal e from integer to computer format function cf(e:integer):string; begin result:=''; while e>0 do begin dec(e); result:=suc(result); end; end; // compare expressions st1, st2 (if st1st2 then 1) function compare(st1,st2:string):shortint; begin if st1=st2 then result:=0 else result:=ifthen(reversestring(st1)>reversestring(st2),1,-1); end; // delete all boosters of b < b, add a booster function bbc(a,b:string):string; begin while (b<>'') and (b<>col) and (compare(a,booster(b))=1) do b:=base(b); result:=''+a+''+b; end; function rest(l,st:string):string; begin if compare(l,st)=1 then result:=st else result:=rest(l,booster(st)); end; function ceill(l,st:string):string; begin if compare(l,st)=1 then result:=l else result:=bbc(ceill(l,booster(st)),st); end; function ledge(st:string):string; var n:integer; begin n:=blevel; if n=1 then result:=bb(,col) else result:=col; while (n>2) and (compare(result,booster(st))=1) do begin dec(n); result:=bbc(result,st); end; end; function fs(st,n:string):string;forward; function cof(st:string):string;forward; function cascade(st:string):string; var x,c,y,d:string; begin x:=booster(st); c:=cof(x); y:=booster©; d:=cof(y); if d=ledge© then result:=bb(fs(x,bb(fs(y,rest(d,x)),base©)),base(st)) else result:=bb(fs(x,cascade©),base(st)); end; // get cofinality of ordinal st function cof; var x,c,l:string; ca:integer; begin result:='[[]]'; if st<>bo then // L if (st=) or (st=col) then // 1, 6 result:=st else begin x:=booster(st); if x='' then // 2 result:='[]' else begin c:=cof(x); if c<>'[]' then // 3 if compare(st,col)=1 then // > R result:=c else begin l:=ledge(st); if compare(l,c)<1 then result:=st // 7 else begin if blevel=1 then ca:=compare(col,c) else ca:=compare(bbc(ceill(l,booster(st)),st),c); if ca=1 then // 4, 5, 8 result:=c else if ca<0 then // 9 result:=cof(cascade(st)); end; end; end; end; end; // get n-th element of fs of ordinal st function fs; var beta,x,c,l:string; i,ca:integer; begin result:=n; if st=bo then // L begin result:=col; for i:=1 to fostn(n) do result:=bb(result,col); for i:=1 to blevel do result:=bb(result,); end else if (st<>) and (st<>col) then // 1, 6 begin x:=booster(st); beta:=base(st); if x='' then // 2 result:=beta else begin c:=cof(x); if c='[]' then // 3 begin result:=beta; x:=base(x); for i:=1 to fostn(n) do result:=bb(x,result); end else if compare(st,col)=1 then // > R result:=bb(fs(x,n),beta) else begin l:=ledge(st); if compare(l,c)=1 then // 7 begin if blevel=1 then ca:=compare(col,c) else ca:=compare(bbc(ceill(l,booster(st)),st),c); if ca=1 then // 4, 5, 8 result:=bb(fs(x,n),beta) else if ca=0 then // 9 begin result:=beta; for i:=1 to fostn(n) do result:=bb(fs(x,result),beta); end else result:=fs(cascade(st),n); end; end; end; end; end; function convert(st:string;z:boolean=false):string; begin if blevel=1 then result:=stringreplace(st,col,'Ω',rfReplaceAll) else if blevel=2 then result:=stringreplace(st,col,'L',rfReplaceAll) else if blevel=3 then result:=stringreplace(st,col,'R',rfReplaceAll) else if blevel=4 then result:=stringreplace(st,col,'S',rfReplaceAll) else result:=stringreplace(st,col,'B'+inttostr(blevel)+'',rfReplaceAll); //result:=st; end; // small expansion of pair c > l function se(c,l:string; yn:integer; var n:string):string; var u:integer; begin repeat result:=fs(c,n); n:=suc(n); if length(n)>35 then er:=true; until er or (l='-') or (compare(result,l)=1); if er then begin ercode:='fs is less than or equal to low element of pair'; form1.Edit1.Text:=c; form1.Edit2.Text:=l; end else if cof©<>'1' then begin for u:=3 to yn do n:=suc(n); if yn>1 then result:=fs(c,n); end; end; // levelup (q - number of levelups, yn - number of fs elements, inserted in last levelup) procedure levelup(q:integer; yn:integer=0); var e,i,y,u,j: integer; n,l,p,a,c: string; begin inc(yn); while not er and (q>0) do begin dec(q); if q>0 then j:=1 else j:=yn; e:=0; c:=se.s; i:=se.c; y:=0; form1.Label2.Caption:=inttostr(cn)+' '; form1.Label2.Refresh; repeat begin n:=cf(se.n); if i=-1 then begin l:='-'; p:=''; end else begin l:=si.s; p:=suc(l); end; if (c<>bo) and (compare(c,p)=0) then begin e:=i; if e>-1 then begin c:=se.s; i:=se.c; if i=-1 then e:=i; end; dec(cn); form1.Label2.Caption:=inttostr(cn)+' '; form1.Label2.Refresh; end else begin a:=se(c,l,j,n); se.n:=fostn(n); if cof©='[]' then u:=j-1 else u:=0; if (c<>bo) and (compare(c,a)<1) then begin er:=true; if compare(c,a)=0 then ercode:='fs element is equal to its argument' else ercode:='fs element is larger than its argument'; form1.Edit1.Text:=c; form1.Edit2.Text:=a; end; if er then form1.Label8.Caption:='Error: '+ercode else while ulength(s) then setlength(s,length(s)*2); form1.Label1.Caption:=inttostr(sl); form1.Label1.Refresh; e:=y; se.c:=i; se.s:=a; se.l:=ifthen(u=j,cl,cl+1); se.n:=0; if u<>j then begin n:=pred(n); a:=fs(c,n); end; end; c:=a; end; end; until er or (e=-1); //until er or (e=-1) or (sl>1000); cn:=y; inc(cl); end; end; function ruq(st:string;uq:rar):rar; var e,i:integer; begin st:=st+'='; result:=uq; while (st<>'=') and (st<>'') do begin e:=system.ord(st1)-48; delete(st,1,1); i:=pos('=',st); resulte:=leftstr(st,i-1); delete(st,1,i); end; end; function wuq(st:string):string; var e:integer; huq:rar; begin huq:=ruq(st,uq); result:=''; for e:=0 to length(uq)-1 do if huqe<>duqe then begin if result<>'' then result:=result+'='; result:=result+chr(e+48)+huqe; end; end; // get html link s, displaying string st function getrefs(s, st: string):string; begin result:=''+st+''; end; procedure ads(st:string); begin if g then cout:=cout+st else writeln(f,st); end; procedure starthtml; begin cout:=''; st:=''; //st:=' '+st; st:=' '+st; st:='sup {font-size: 0.83rem;}'+st; st:='sub {font-size: 0.83rem;}'+st; st:='